home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Support Library
/
RoseWare - Network Support Library.iso
/
apidev
/
basnet.arc
/
LOGIN2.BAS
< prev
next >
Wrap
BASIC Source File
|
1987-07-14
|
8KB
|
211 lines
542 MODE% = 2 'GET THE CURRENT EFFECTIVE SERVER
543 DEF SEG = LIBSEG
544 CALL SETSERV(MODE%,DRIVE%,CURR%)
545 DEF SEG
547 MODE% = 3 'get server mapping table address function
550 '
553 DEF SEG = LIBSEG
557 CALL GETSTA(MODE%, STSEGMENT%, STOFFSET%) 'Func EFh
560 MODE% = 4
563 CALL GETSTA(MODE%,STSEGMENT%,NTOFF%) 'Func EFh
567 DEF SEG = STSEGMENT%
570 '
573 ' Now we will display the table contents for demo purposes
575 LOCATE 13,31
577 PRINT "Server mapping table contents:": PRINT
580 FOR I = 0 TO 7
584 T=15 + I
585 LOCATE T,30
586 PRINT I+1;:IF I+1=CURR% THEN PRINT "* "; ELSE PRINT " ";
587 FOR X = 0 TO 13
590 PRINT RIGHT$("00"+HEX$(PEEK(STOFFSET% + (32*I) + X)),2);
593 NEXT X
597 PRINT SPC(3);
600 FOR X = 0 TO 19
603 A$ = CHR$(PEEK(NTOFF% + (I*48) + X))
607 IF A$ = CHR$(0) THEN X = 19 ELSE PRINT A$;
610 NEXT X
613 PRINT
617 NEXT I
650 Input "a to attach or v to view or l to login",r$
660 if r$="a" then gosub 1000:goto 542
710 if r$="l" then gosub 4000:goto 542
720 if r$="v" then 542
800 end
1000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
1010 ' Begin ATTACH
1020 CLS
1025 PRINT "SERVER NAME
1030 PRINT "-----------
1035 PRINT
1040 LASTOBJECTID$ = STRING$(4,255)
1045 RETURNCODE% = 0
1050 PATTERNTYPEHI$ = CHR$(0)
1055 PATTERNTYPELO$ = CHR$(4)
1060 REQPACLENHI$ = CHR$(0)
1065 REQPACLENLO$ = CHR$(9)
1070 FUNC$ = CHR$(55) 'scan for objects subfunction
1075 PATTERNLEN$ = CHR$(1)
1080 PATTERN$ = "*"
1085 REPPACLENHI$ = CHR$(0)
1090 REPPACLENLO$ = CHR$(57)
1095 WHILE RETURNCODE% <> 252
1100 'set up the request buffer
1105 OBJREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + LASTOBJECTID$ + PATTERNTYPEHI$ + PATTERNTYPELO$ + PATTERNLEN$ + PATTERN$
1110 'set up the reply buffer
1115 OBJREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),"x")
1120 'make the bindery request
1125 DEF SEG = LIBSEG
1130 CALL SYSLOG(RETURNCODE%,OBJREQ$,OBJREPLY$)
1135 DEF SEG
1140 IF RETURNCODE% <> 252 THEN PRINT MID$(OBJREPLY$,9,48) ELSE OBJREPLY$ = STRING$(60,CHR$(0))
1145 LASTOBJECTID$ = MID$(OBJREPLY$,3,4)
1150 WEND
1155 print
1160 INPUT "Enter file server name you wish to attach to: ",SERVERNAME$
1165 IF SERVERNAME$ = "" THEN GOTO 1999
1170 ' now get the net address of the server
1175 GOSUB 18000
1180 IF PROPRETCODE% <> 0 THEN GOTO 1999
1190 '
1210 ' now check the table for target server match and an open entry to use
1220 SERVERMATCH% = 0: INSERT% = 0
1225 DEF SEG = STSEGMENT%
1230 FOR ENTRY% = 7 TO 0 STEP -1
1250 IF PEEK(STOFFSET% + (32 * ENTRY%)) <> 255 THEN INSERT% = ENTRY%+1: GOTO 1280
1251 DMY$ = ""
1252 FOR I = 2 TO 13
1254 DMY$ = DMY$ + CHR$(PEEK(STOFFSET%+32*ENTRY%+I))
1256 NEXT I
1258 IF TARGETADDRESS$ = DMY$ THEN SERVERMATCH% = ENTRY% + 1: GOTO 1290
1280 NEXT
1290 DEF SEG
1295 IF SERVERMATCH% THEN INPUT "That server is in the table. <enter>",V$:GOTO 1999
1400 '
1405 ' we now need to insert our server address into the table.
1410 '
1500 IF INSERT% = 0 THEN INPUT "There are no free entries. <enter>",V$: GOTO 1999
1520 TARGETBASEADD% = STOFFSET% + (32 * (INSERT% -1))
1590 DEF SEG = STSEGMENT%
1600 FOR CHARNO% = 1 TO 12
1620 THISCHAR% = ASC(MID$(TARGETADDRESS$,CHARNO%,1))
1630 THISADD% = TARGETBASEADD% + CHARNO% + 1
1640 POKE THISADD%,THISCHAR%
1660 NEXT
1662 FOR X% = 1 TO LEN(SERVERNAME$)
1664 THISCHAR% = ASC(MID$(SERVERNAME$,X%,1))
1665 THISADDR% = STOFFSET% + 8*32 + (INSERT% - 1)*48 + X% - 1
1666 POKE THISADDR%,THISCHAR%
1668 NEXT
1669 POKE THISADDR%+1,0
1670 DEF SEG
1700 '
1705 ' now we need to set the order numbers for the server mapping table
1710 SLOT% = 1 'initialize the variable for a value higher than the table can hold
1715 DEF SEG = STSEGMENT%
1720 FOR CHKENTRY% = 0 TO 7
1730 THISOFF% = STOFFSET% + (32*CHKENTRY%)
1740 IF PEEK(THISOFF%) <> 255 THEN GOTO 1770
1745 DMY$ = ""
1750 FOR I = 2 TO 13
1752 DMY$ = DMY$ + CHR$(PEEK(THISOFF% + I))
1754 NEXT
1756 IF TARGETADDRESS$ > DMY$ THEN SLOT% = SLOT% + 1: GOTO 1770
1758 POKE THISOFF%+1,PEEK(THISOFF%+1)+1
1770 NEXT
1780 '
1810 ' we need to set the in use flag for our new entry and the new order #
1830 POKE TARGETBASEADD%, 255:POKE TARGETBASEADD%+1,SLOT%
1890 '
1900 ' finally, we must make the call to attach to our new server
1905 ' (Function Call F1h)
1910 MODE% = 0 'mode to create an attachment
1920 RETCODE% = 0
1930 DEF SEG = LIBSEG
1940 CALL MODSERV(MODE%,SLOT%,RETCODE%) 'Func F1h
1950 DEF SEG
1960 IF RETCODE% <> 0 THEN INPUT "Attempt to attach failed <RETURN> to continue.",R$
1999 return
4000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
4005 ' Begin LOGIN
4010 '
4020 ' first we need to select the file server which is the target
4030 ' of our request
4040 '
4041 LOCATE 24,1
4042 INPUT "Enter slot # of the server to be logged in to: ",SLOT$
4043 IF SLOT$ = "" THEN 4999
4044 SLOT% = VAL(SLOT$)
4046 IF (SLOT%<1) OR (SLOT%>8) THEN GOTO 4041
4050 MODE% = 0 'mode to set the preferred file server
4060 def seg=libseg
4070 CALL SETSERV(MODE%,SLOT%,CURRENTSERVER%) 'Func F0h(00H)
4080 def seg
4072 mode% = 2
4073 def seg=libseg
4074 call setserv(mode%,slot%,currentserver%) 'Func f0h(02h)
4076 def seg
4080 Print "Current Server is ",currentserver%
4200 ' and now we will log in
4210 ' set up the request packet
4212 INPUT "Enter login name: ",LOGNAME$
4214 input "Enter password: ",password$
4220 REQPACLENHI$ = CHR$(0)
4230 REQPACLENLO$ = CHR$(LEN(LOGNAME$)+Len(password$)+3)
4240 FUNC$ = CHR$(0) 'login subfunction
4250 LOGNAMELEN$ = CHR$(LEN(LOGNAME$))
4270 PASSWORDLEN$ = CHR$(len(password$))
4290 REQPACKET$ = REQPACLENLO$+REQPACLENHI$+FUNC$+LOGNAMELEN$+LOGNAME$+PASSWORDLEN$+Password$
4300 ' set up the reply buffer
4310 REPPACLENHI$ = CHR$(0)
4320 REPPACLENLO$ = CHR$(20)
4330 REPLYPACKET$ = REPPACLENLO$+REPPACLENHI$
4340 'make the login request
4350 DEF SEG = LIBSEG
4360 CALL SYSLOG(ERRCODE%,REQPACKET$,REPLYPACKET$) 'Func E3h(00h)
4370 DEF SEG
4380 IF ERRCODE% <> 0 THEN PRINT "Error -> "ERRCODE%: INPUT "<enter>",V$: GOTO 4041
4390 INPUT "login successful <enter>",v$
4999 return
18000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
18005 ' set up the request packet to get the net address
18010 ' (Function Call E3h(3Dh) also see Function Call Ref pg. 8-5)
18030 '
18040 FUNC$ = CHR$(61) 'get a properites value subfunction 3Dh
18110 OBJTYPE$ = CHR$(0) + CHR$(4)
18120 OBJNAME$ = SERVERNAME$
18130 OBJNAMELEN$ = CHR$(LEN(OBJNAME$))
18140 SEGNUM$ = CHR$(1)
18150 PROPNAME$ = "NET_ADDRESS"
18160 PROPLEN$ = CHR$(LEN(PROPNAME$))
18190 PROPVALREQ$ = FUNC$ + OBJTYPE$ + OBJNAMELEN$ + OBJNAME$ + SEGNUM$ + PROPLEN$ + PROPNAME$
18192 LGTH$ = CHR$(LEN(PROPVALREQ$)) + CHR$(0)
18195 PROPVALREQ$ = LGTH$ + PROPVALREQ$
18200 ' set up the reply buffer
18210 REPPACLENHI$ = CHR$(0)
18220 REPPACLENLO$ = CHR$(130)
18230 PROPVALREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$(130," ")
18300 'make the bindery request
18310 DEF SEG = LIBSEG
18320 CALL SYSLOG(PROPRETCODE%,PROPVALREQ$,PROPVALREPLY$) 'Func E3h(3Dh)
18330 DEF SEG
18340 IF PROPRETCODE% <> 0 THEN INPUT "No address was found for that Server. <ENTER>",V$:RETURN
18345 '
18350 ' we will put the address in a string to use later
18360 TARGETADDRESS$ = MID$(PROPVALREPLY$,3,12)
18370 ' for demo purposes we will print the address if we found one
18372 NTW$=""
18375 FOR I = 3 TO 14
18380 NTW$= NTW$+RIGHT$("00"+HEX$(ASC(MID$(PROPVALREPLY$,I,1))),2)
18390 NEXT I
18400 NET$ = MID$(NTW$,1,8): NODE$ = MID$(NTW$,9,12): SOC$ = MID$(NTW$,21,4)
18430 PRINT "NET is " NET$" NODE is " NODE$" SOCKET is " SOC$
18440 INPUT " <enter>",V$
18999 RETURN